Slider on Microsoft Access Form using VBA.

This article is about to make sliding Form on Microsoft Access. On Microsoft Access form we are inserting a SubForm which contains the Web Browser object. This article demonstrates the sliding using VBA code. We are using expanding and collapsing the form on button click.

Firstly we have to insert a Form. On the field of Form we are inserting a web browser object and a button for sliding as shown in Fig 1.1. We have to code on this button event.

Then we have to insert another from which will act like as main form. In this Form we have to insert a subform using previous Form. According to visibility we have to set the control as shown in Fig 1.2.

Then we have to open this main Form in Form View .It will show like Fig 1.3.

Then we have to click on SubForm slide button on main Form. The SubForm will open and it would enable the expansion and browsing also as shown in Fig 1.4. And again when we click on similar button the sliding is extract as Fig 1.3.

VBA CODE

Option Compare Database
Option Explicit

Private Const sModName = "Form_subform"
Dim frmInitWidth As Long
Const iResizeInterval As Long = 100

Private Sub cmd_Expand_Click()
On Error GoTo Error_Handler
Dim FORMWIDTH As Long
Dim INITIALLEFT As Long
If HasParent = True Then
FORMWIDTH = Me.Width

'Expand >>>>Retract<<<<<<
If Me.Parent.subform.Width = frmInitWidth Then
Me.txt_FocusHolder.SetFocus
Me.cmd_Expand.Enabled = False
INITIALLEFT = Me.Parent.subform.Left
Do While Me.Parent.subform.Left - Me.cmd_Expand.Width > (INITIALLEFT - FORMWIDTH)
Me.Parent.subform.Left = Me.Parent.subform.Left - iResizeInterval
Me.Parent.subform.Width = Me.Parent.subform.Width + iResizeInterval
DoEvents
Loop
Me.Parent.subform.Width = FORMWIDTH
Me.cmd_Expand.Enabled = True
Me.cmd_Expand.Caption = "SLIDEBAR"
Me.cmd_Expand.SetFocus
Else
Me.txt_FocusHolder.SetFocus
Me.cmd_Expand.Enabled = False
INITIALLEFT = Me.Parent.subform.Left
Do While Me.Parent.subform.Left + Me.cmd_Expand.Width < (INITIALLEFT + FORMWIDTH)
Me.Parent.subform.Left = Me.Parent.subform.Left + iResizeInterval
Me.Parent.subform.Width = Me.Parent.subform.Width - iResizeInterval
DoEvents
Loop
Me.Parent.subform.Width = frmInitWidth
Me.cmd_Expand.Enabled = True
Me.cmd_Expand.Caption = "SLIDE"
Me.cmd_Expand.SetFocus
End If
End If

Error_Handler_Exit:
On Error Resume Next
Exit Sub
Error_Handler:
MsgBox "The following error has occured." & vbCrLf & vbCrLf & "Error Number: " & Err.Number & vbCrLf & _ "Error Source: " & sModName & "/cmd_Expand_Click" & vbCrLf & _ "Error Description: " & Err.Description, _ vbCritical, "ERROR!"
Resume Error_Handler_Exit
End Sub
Private Sub Form_Open(Cancel As Integer)
On Error GoTo Error_Handler
If HasParent = True Then
Me.cmd_Expand.Caption = "SLIDE"
frmInitWidth = Me.Parent.subform.Width
End If
Error_Handler_Exit:
On Error Resume Next
Exit Sub
Error_Handler:
MsgBox "The following error has occured." & vbCrLf & vbCrLf & _ "Error Number: " & Err.Number & vbCrLf & _ "Error Source: " & sModName & "/Form_Open" & vbCrLf & _ "Error Description: " & Err.Description, _ vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
End Sub
Private Property Get HasParent() As Boolean
On Error GoTo Error_Handler_Exit
HasParent = TypeName(Me.Parent.Name) = "String"
Error_Handler_Exit:
On Error Resume Next
Exit Property
End Property